home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok59 / lists1.4e / lists.mod < prev    next >
Text File  |  1993-11-04  |  7KB  |  340 lines
  1. (**************************************************************************
  2.  
  3. :Program.    Lists.mod
  4. :Author.     Fridtjof Siebert, Hartmut Goebel [hG]
  5. :Language.   Oberon
  6. :Translator. AmigaOberon V2.00
  7. :History.    V1.0, 17-Jun-90 Fridtjof Siebert
  8. :History.    V1.1, 10-Jan-91 H.Goebel: AddSection...,GoForw./Backw.
  9. :History.    V1.2, 28-Mar-91   [hG] SetMark, ..Area..->..Mark..
  10. :History.    V1.3, 30 Sep 1991 [hG] + GetPred, GetSucc, Swap
  11. :History.    V1.4, 17 Oct 1991 [hG] + IsElement
  12. :History.    V1.4b 21 Oct 1991 [hG] - Bug in Swap
  13. :Date.       21 Oct 1991 12:17:01
  14.  
  15. **************************************************************************)
  16.  
  17. MODULE Lists;
  18.  
  19. TYPE
  20.   NodePtr* = POINTER TO Node;
  21.   Node* = RECORD
  22.             next,prev: NodePtr;
  23.           END;
  24.   List* = RECORD
  25.             head : NodePtr;
  26.             tail : NodePtr;
  27.             remallowed: INTEGER;
  28.           END;
  29.   Mark* = List;
  30.  
  31.   DoProc * = PROCEDURE(n: NodePtr);
  32.  
  33. (* Die DoProc darf Remove(), RemHead() und RemTail() nicht benutzen. *)
  34.  
  35.  
  36. PROCEDURE Init*(VAR list: List);
  37. BEGIN
  38.   list.head := NIL;
  39.   list.tail := NIL;
  40.   list.remallowed := 0;
  41. END Init;
  42.  
  43. (*------ Add ------------------------------*)
  44.  
  45. PROCEDURE AddHead*(VAR list: List; n: NodePtr);
  46. BEGIN
  47.   n.next := list.head;
  48.   n.prev := NIL;
  49.   IF n.next=NIL THEN list.tail   := n;
  50.                 ELSE n.next.prev := n END;
  51.   list.head := n;
  52. END AddHead;
  53.  
  54.  
  55. PROCEDURE AddTail*(VAR list: List; n: NodePtr);
  56. BEGIN
  57.   n.prev := list.tail;
  58.   n.next := NIL;
  59.   IF n.prev=NIL THEN list.head   := n;
  60.                 ELSE n.prev.next := n END;
  61.   list.tail := n;
  62. END AddTail;
  63.  
  64.  
  65. PROCEDURE AddBefore*(VAR list: List;
  66.                          n,x: NodePtr);
  67. (* fügt n vor x in die Liste ein *)
  68.  
  69. BEGIN
  70.   n.prev := x.prev;
  71.   n.next := x;
  72.   x .prev := n;
  73.   IF n.prev=NIL THEN list.head   := n
  74.                 ELSE n.prev.next := n END;
  75. END AddBefore;
  76.  
  77.  
  78. PROCEDURE AddBehind*(VAR list: List;
  79.                          n,x: NodePtr);
  80. (* fügt n hinter x in die Liste ein *)
  81.  
  82. BEGIN
  83.   n.next := x.next;
  84.   n.prev := x;
  85.   x .next := n;
  86.   IF n.next=NIL THEN list.tail   := n
  87.                 ELSE n.next.prev := n END;
  88. END AddBehind;
  89.  
  90. (*------ Remove ---------------------------*)
  91.  
  92. PROCEDURE Remove*(VAR list: List; n: NodePtr);
  93. BEGIN
  94.   IF n#NIL THEN
  95.     IF list.remallowed # 0 THEN HALT(20) END;
  96.     IF n.next#NIL THEN n.next.prev := n.prev ELSE list.tail := n.prev END;
  97.     IF n.prev#NIL THEN n.prev.next := n.next ELSE list.head := n.next END;
  98.   END;
  99. END Remove;
  100.  
  101.  
  102. PROCEDURE RemHead*(VAR list: List): NodePtr;
  103. VAR n: NodePtr;
  104. BEGIN
  105.   n := list.head; Remove(list,n); RETURN n;
  106. END RemHead;
  107.  
  108.  
  109. PROCEDURE RemTail*(VAR list: List): NodePtr;
  110. VAR n: NodePtr;
  111. BEGIN
  112.   n := list.tail; Remove(list,n); RETURN n;
  113. END RemTail;
  114.  
  115. (*------ Do Forward/Backward --------------*)
  116.  
  117. PROCEDURE DoForward*(VAR list: List; proc: DoProc);
  118. VAR n: NodePtr;
  119. BEGIN
  120.   INC(list.remallowed);
  121.   n := list.head; WHILE n#NIL DO proc(n); n := n.next END;
  122.   DEC(list.remallowed);
  123. END DoForward;
  124.  
  125.  
  126. PROCEDURE DoBackward*(VAR list: List; proc: DoProc);
  127. VAR n: NodePtr;
  128. BEGIN
  129.   INC(list.remallowed);
  130.   n := list.tail; WHILE n#NIL DO proc(n); n := n.prev END;
  131.   DEC(list.remallowed);
  132. END DoBackward;
  133.  
  134. (*------ Elements -------------------------*)
  135.  
  136. PROCEDURE Next*(VAR n: NodePtr): BOOLEAN;
  137. BEGIN
  138.   n := n.next;
  139.   RETURN n#NIL;
  140. END Next;
  141.  
  142.  
  143. PROCEDURE Previous*(VAR n: NodePtr): BOOLEAN;
  144. BEGIN
  145.   n := n.prev;
  146.   RETURN n#NIL;
  147. END Previous;
  148.  
  149.  
  150. PROCEDURE Succ*(VAR n: NodePtr);
  151. BEGIN
  152.   n := n.next;
  153. END Succ;
  154.  
  155.  
  156. PROCEDURE Pred*(VAR n: NodePtr);
  157. BEGIN
  158.   n := n.prev;
  159. END Pred;
  160.  
  161.  
  162. PROCEDURE GetSucc*(n: NodePtr): NodePtr;
  163. BEGIN
  164.   RETURN n.next;
  165. END GetSucc;
  166.  
  167.  
  168. PROCEDURE GetPred*(n: NodePtr): NodePtr;
  169. BEGIN
  170.   RETURN n.prev;
  171. END GetPred;
  172.  
  173.  
  174. PROCEDURE Head*(VAR list: List): NodePtr;
  175. BEGIN
  176.   RETURN list.head;
  177. END Head;
  178.  
  179.  
  180. PROCEDURE Tail*(VAR list: List): NodePtr;
  181. BEGIN
  182.   RETURN list.tail;
  183. END Tail;
  184.  
  185. (*------ Go Forward/Backward --------------*)
  186.  
  187. PROCEDURE GoForward*(list: List; VAR n: NodePtr; num: LONGINT);
  188. BEGIN
  189.   WHILE (num>0) AND (n#NIL) DO
  190.     n := n.next;
  191.     DEC(num);
  192.   END;
  193.   IF n=NIL THEN n:=list.tail; END;
  194. END GoForward;
  195.  
  196.  
  197. PROCEDURE GoBackward*(list: List; VAR n: NodePtr; num: LONGINT);
  198. BEGIN
  199.   WHILE (num>0) AND (n#NIL) DO
  200.     n := n.prev;
  201.     DEC(num);
  202.   END;
  203.   IF n=NIL THEN n:=list.head; END;
  204. END GoBackward;
  205.  
  206. (*------ misc -----------------------------*)
  207.  
  208. PROCEDURE Empty*(VAR list: List): BOOLEAN;
  209. BEGIN
  210.   RETURN list.head=NIL
  211. END Empty;
  212.  
  213.  
  214. PROCEDURE IsElement*(VAR list: List; e: NodePtr): BOOLEAN;
  215. VAR
  216.   n: NodePtr;
  217. BEGIN
  218.   n := list.head;
  219.   WHILE n # NIL DO
  220.     IF n = e THEN RETURN TRUE; END;
  221.     n := n.next;
  222.   END;
  223.   RETURN FALSE;
  224. END IsElement;
  225.  
  226.  
  227. PROCEDURE CountElements*(VAR list: List): LONGINT;
  228. VAR
  229.   i: LONGINT;
  230.   n: NodePtr;
  231. BEGIN
  232.   i := 0;
  233.   n := list.head;
  234.   WHILE n#NIL DO n := n.next; INC(i) END;
  235.   RETURN i;
  236. END CountElements;
  237.  
  238.  
  239. PROCEDURE Swap*(VAR list: List; a,b: NodePtr);
  240. VAR
  241.   c: NodePtr;
  242. BEGIN
  243.   c := a.next;
  244.   IF b.next # a THEN  (* wird sonst an der gleichen Stelle wieder eingefügt *)
  245.     Remove(list,a);
  246.     AddBehind(list,a,b);
  247.   END;
  248.   IF c # b THEN       (* b war Succ(a) *)
  249.     Remove(list,b);
  250.     IF c = NIL THEN
  251.       AddTail(list,b);
  252.     ELSE
  253.       AddBefore(list,b,c);
  254.     END;
  255.   END;
  256. END Swap;
  257.  
  258. (*------ marks and things around ----------*)
  259.  
  260. PROCEDURE AddMarkBefore*(VAR list: List; mark: Mark; x: NodePtr);
  261. (* fügt mark vor x in die Liste ein *)
  262.  
  263. BEGIN
  264.   mark.head.prev := x.prev;
  265.   mark.tail.next := x;
  266.   x.prev := mark.tail;
  267.   IF mark.head.prev=NIL THEN list.head := mark.head
  268.                 ELSE mark.head.prev.next := mark.head END;
  269.   INC(mark.remallowed);
  270. END AddMarkBefore;
  271.  
  272.  
  273. PROCEDURE AddMarkBehind*(VAR list: List; mark: Mark; x: NodePtr);
  274. (* fügt mark hinter x in die Liste ein *)
  275.  
  276. BEGIN
  277.   mark.tail.next := x.next;
  278.   mark.head.prev := x;
  279.   x.next := mark.head;
  280.   IF mark.tail.next=NIL THEN list.tail := mark.tail
  281.                      ELSE mark.tail.next.prev := mark.tail END;
  282.   INC(mark.remallowed);
  283. END AddMarkBehind;
  284.  
  285.  
  286. PROCEDURE AddMarkHead*(VAR list: List; mark: Mark);
  287. BEGIN
  288.   mark.tail.next := list.head;
  289.   mark.head.prev := NIL;
  290.   IF mark.tail.next=NIL THEN list.tail   := mark.tail;
  291.                 ELSE mark.tail.next.prev := mark.tail END;
  292.   list.head := mark.head;
  293.   INC(mark.remallowed);
  294. END AddMarkHead;
  295.  
  296.  
  297. PROCEDURE AddMarkTail*(VAR list: List; mark: Mark);
  298. BEGIN
  299.   mark.head.prev := list.tail;
  300.   mark.tail.next := NIL;
  301.   IF mark.head.prev=NIL THEN list.head   := mark.head;
  302.                 ELSE mark.head.prev.next := mark.head END;
  303.   list.tail := mark.tail;
  304.   INC(mark.remallowed);
  305. END AddMarkTail;
  306.  
  307.  
  308. PROCEDURE RemoveMark*(VAR list: List; mark: Mark);
  309. BEGIN
  310.   IF (mark.head#NIL) AND (mark.tail#NIL)THEN
  311.     IF list.remallowed # 0 THEN HALT(20) END;
  312.     IF mark.tail.next#NIL THEN
  313.       mark.tail.next.prev := mark.head.prev
  314.     ELSE
  315.       list.tail := mark.head.prev
  316.     END;
  317.     IF mark.head.prev#NIL THEN
  318.       mark.head.prev.next := mark.tail.next
  319.     ELSE
  320.       list.head := mark.tail.next
  321.     END;
  322.   END;
  323.   DEC(mark.remallowed);
  324. END RemoveMark;
  325.  
  326.  
  327. PROCEDURE SetMark*(VAR mark: Mark; h,t: NodePtr);
  328. BEGIN
  329.   IF (h=NIL) AND (t=NIL) THEN
  330.     mark.head := NIL; mark.tail := NIL;
  331.   ELSE
  332.     IF h#NIL THEN mark.head := h; END;
  333.     IF t#NIL THEN mark.tail := t; END;
  334.   END;
  335.   IF mark.remallowed=0 THEN mark.remallowed := 1; END;
  336. END SetMark;
  337.  
  338. END Lists.
  339.  
  340.